Political Donations of Professional Sports Team Owners

Top 25 Highest Political Donations by NFL Team Owners in 2016

Table of Owners Who Make the Most Donations

library(knitr)
library(pander)
library(tidyverse)
library(kableExtra)
## 
## Attaching package: 'kableExtra'
## The following object is masked from 'package:dplyr':
## 
##     group_rows
owner_rank2 <- pol_donations %>% group_by(Owner, Team, League) %>%
  summarise(n = n()) %>%
  arrange(desc(n)) %>%
  filter(n >= 65)
## `summarise()` has grouped output by 'Owner', 'Team'. You can override using the `.groups` argument.
kable(owner_rank2, caption = "<b>Who Makes the Most Donations Across All Leagues?<b>", format = "html",
      col.names = c("Owner", "Team", "League", "Donations Made")) %>%
  kable_styling(html_font = "Cambria", bootstrap_options = "striped",
                font_size = 9) 
Who Makes the Most Donations Across All Leagues?
Owner Team League Donations Made
Charles Johnson San Francisco Giants MLB 213
Micky Arison Miami Heat NBA 178
John Rogers Chicago Sky WNBA 149
Dan DeVos Orlando Magic NBA 116
Jody Allen (Paul G. Allen Trust) Portland Trail Blazers, Seattle Seahawks NBA, NFL 108
Jimmy and Susan Haslam Cleveland Browns NFL 102
Ken Kendrick Arizona Diamondbacks MLB 86
Jerry Reinsdorf Chicago Bulls, Chicago White Sox NBA, MLB 78
Herbert Simon Indiana Pacers, Indiana Fever NBA, WNBA 68
Stephen M. Ross Miami Dolphins NFL 65

How Much Do They Donate?

Examining Top Donator

library(ggthemes)
charles_johnson <- pol_donations %>% filter(Owner == "Charles Johnson") %>%
  filter(year == 2016 | year == 2018 | year == 2020) 

cj_party <- charles_johnson %>% group_by(Party) %>%
  summarise(n = n()) %>%
  mutate(party = fct_reorder(.f = Party, .x = n)) %>%
   mutate(Party = fct_relevel(party, c("Republican", "Bipartisan, but mostly Republican",
                                         "Democrat")))

level_order2 <- factor(charles_johnson$Party, level = c('Republican', 'Democrat', 'Bipartisan, but mostly Republican'))

ggplot(data = cj_party, aes(x = party, y = n, fill = Party)) +
  geom_col() +
  coord_flip() +
  scale_fill_viridis_d(option = "plasma") +
  labs(title = "Is There Any Political Party Receiving More Support From Charles Johnson?",
       x = " ",
       y = "Count of Donations") +
  theme(legend.position = "bottom",
        plot.title = element_text(family = "mono",
                                  face = "bold",
                                  hjust = 0.5,
                                  size = 13,
                                  margin = margin(c(t = 50,
                                                    b = 50)),
                                  vjust = 10),
        axis.text = element_text(family = "mono"),
        legend.title = element_text(family = "mono",
                                    face = "bold"),
        legend.text = element_text(family = "mono"),
        axis.ticks.y = element_blank(),
        axis.ticks.x = element_blank(),
        axis.title.x = element_text(family = "mono",
                                    size = 9,
                                    face = "italic",
                                    margin = margin(t = 20)))

cj_party2 <- cj_party %>% select(n, party)

ggplot(data = cj_party, aes(x = party, y = n, fill = Party)) +
  geom_col() + 
  annotate(geom = "table") +
  coord_flip()

What Are Some of These Organizations?

organizations <- charles_johnson %>% group_by(Recipient, Party) %>%
  summarise(n = n()) %>%
  arrange(desc(n)) %>%
  filter(n >= 2)
## `summarise()` has grouped output by 'Recipient'. You can override using the `.groups` argument.
kable(organizations, caption = "<b>What Are Some Organizations Charles Johnson Donates To?<b>",
      col.names = c("Recipient", "Political Party", "Amount of Donations Made"))  %>%
  kable_styling(html_font = "Cambria", bootstrap_options = "striped",
                font_size = 15) %>%
  scroll_box(height = "500px")
What Are Some Organizations Charles Johnson Donates To?
Recipient Political Party Amount of Donations Made
CONGRESSIONAL LEADERSHIP FUND Republican 3
MOONEY VICTORY FUND Republican 3
SENATE LEADERSHIP FUND Republican 3
TRUMP VICTORY Republican 3
VIGOP (VIRGIN ISLANDS REPUBLICAN PARTY) Republican 3
ALEX MOONEY FOR CONGRESS Republican 2
CHIP ROY FOR CONGRESS Republican 2
CORNYN MAJORITY COMMITTEE Republican 2
FASO FOR CONGRESS Republican 2
HURD FOR CONGRESS Republican 2
INVESTMENT COMPANY INSTITUTE POLITICAL ACTION COMMITTEE Bipartisan, but mostly Republican 2
JACKIE SPEIER FOR CONGRESS Democrat 2
KATKO FOR CONGRESS Republican 2
MAST VICTORY COMMITTEE Republican 2
MCSALLY FOR SENATE INC Republican 2
RESTORATION PAC Republican 2
TEAM RYAN Republican 2
TRUE NORTH PAC Republican 2
WALTERS FOR CONGRESS Republican 2
ZELDIN FOR CONGRESS Republican 2

Organizations Receiving Most Donations Across All Leagues

recipients <- pol_donations %>% group_by(Recipient, Party) %>%
  summarise(n = n()) %>%
  arrange(desc(n)) %>%
  filter(n >= 15) %>%
  ungroup() %>%
  mutate(recipient = fct_reorder(.f = Recipient, .x = n)) %>%
  mutate(Party = fct_relevel(Party, c("Bipartisan", "Republican", "Democrat")))
## `summarise()` has grouped output by 'Recipient'. You can override using the `.groups` argument.
new_names <- c("Collins For Senator", "McSally for Senate Inc.",
               "ActBlue", "Portman For Senate Committee", "NRCC",
               "NRSC", "Hillary Victory Fund", "Team Ryan", 
               "Office of the Commissioner of MLB PAC", "Gridirion PAC")

ggplot(data = recipients, aes(x = recipient, y = n, colour = Party)) +
  geom_point() +
  geom_segment(aes(x = recipient, xend = recipient, y = 0, yend = n)) +
  coord_flip() +
  labs(x = " ",
       y = "Count of Donations") +
  labs(title = "Organizations Receiving Most Donations Among All Owners") +
  scale_colour_brewer(palette = "Dark2") +
  theme(legend.position = "bottom") +
  scale_x_discrete(labels = new_names) +
  theme(plot.title = element_text(family = "mono",
                                  face = "bold",
                                  margin = margin(c(t = 50,
                                                    b = 50)),
                                  vjust = 10),
        axis.text = element_text(family = "mono"),
        axis.title = element_text(family = "mono",
                                  size = 8),
        axis.title.x = element_text(size = 10,
                                    margin = margin(t = 20,
                                                    b = 10)),
        legend.title = element_text(family = "mono",
                                    face = "bold"),
        legend.text = element_text(family = "mono"),
        axis.ticks = element_blank(),
         legend.box.background = element_rect())

pol_donations %>% group_by(League) %>%
  summarise(n = n()) %>%
  arrange(desc(n))
## # A tibble: 16 × 2
##    League             n
##    <chr>          <int>
##  1 MLB              746
##  2 NBA              462
##  3 NFL              444
##  4 NHL              329
##  5 WNBA             274
##  6 NBA, WNBA        118
##  7 NBA, NFL         109
##  8 NBA, NHL         109
##  9 NBA, MLB          84
## 10 NASCAR            79
## 11 NBA, NHL, WNBA    15
## 12 NHL, NFL          12
## 13 MLB, NHL           7
## 14 MLB, WNBA          6
## 15 NBA, NFL, NHL      3
## 16 MLB, NASCAR        1

Blockbuster Ratings: 1977 to 2019

## # A tibble: 5 × 2
##   mpaa_rating     n
##   <chr>       <int>
## 1 G              23
## 2 PG            133
## 3 PG-13         178
## 4 R              95
## 5 <NA>            1

## # A tibble: 4 × 2
##   mpaa_rating     n
##   <chr>       <int>
## 1 G              23
## 2 PG            133
## 3 PG-13         178
## 4 R              95

Has the Budget for Blockbusters Increased Throughout Time?

ggplot(data = blockbusters, aes(x = release_year, y = film_budget, colour = release_year)) +
  geom_point() +
  geom_smooth(se = FALSE, method = "lm", colour = "black") +
  labs(x = "Release Year",
       y = "Film Budget",
       title = "Has the Budget for Blockbuster Films Increased Throughout Time?",
       subtitle = "Film Budget for Blockbusters: 1977-2019") +
  theme_bw() +
  scale_colour_viridis_c() +
  theme(legend.position = "none",
        plot.title = element_text(family = "mono",
                                  face = "bold",
                                  margin = margin(c(t = 50, b = 50)),
                                  vjust = 10),
        plot.subtitle = element_text(family = "mono",
                                     face = "italic",
                                     vjust = 5),
        axis.title = element_text(family = "mono",
                                  face = "bold"),
        axis.text = element_text(family = "mono"),
        axis.ticks = element_blank(),
        axis.title.x = element_text(margin = margin(c(l = 20))),
        axis.title.y = element_text(margin = margin(c(t = 20, b = 20, r = 20)))) 
## `geom_smooth()` using formula 'y ~ x'

## need to add more to this visualization 

Which American/Domestic Distributor Has Produced the Most Blockbusters 1977-2019

blockbusters3 <- blockbusters %>% group_by(domestic_distributor) %>%
  summarise(n = n()) %>%
  arrange(desc(n)) %>%
  mutate(order = fct_reorder(.f = domestic_distributor, .x = n)) %>%
  filter(!n == 1)

ggplot(data = blockbusters3, aes(x = order, y = n, fill = order)) +
  geom_point() +
  geom_segment(aes(x = order, xend = order, y = 0, yend = n)) +
  coord_flip() +
  geom_label(data = blockbusters3, aes(label = n), show.legend = FALSE) +
  labs(x = "Amount of Films Produced",
       y = "Domestic Distributor",
       title = "Amount of Blockbusters Produced by Domestic Distributors: 1977-2019") +
  theme_bw() +
  theme(legend.position = "none",
        plot.title = element_text(family = "mono",
                                  face = "bold",
                                  margin = margin(c(t = 50)),
                                  vjust = 10),
        axis.title = element_text(family = "mono",
                                  face = "bold"),
        axis.text = element_text(family = "mono"),
        axis.text.y = element_text(face = "italic"),
        axis.ticks = element_blank(),
        axis.title.x = element_text(margin = margin(c(b = 20))),
        axis.title.y = element_text(margin = margin(c(t = 30, r = 30))))

Work in Progress

blockbusters
## # A tibble: 430 × 13
##    release_year rank_in_year imdb_rating mpaa_rating film_title      film_budget
##           <dbl>        <dbl>       <dbl> <chr>       <chr>                 <dbl>
##  1         2019            1         8.5 PG-13       Avengers: Endg…   356000000
##  2         2019            2         7   PG          The Lion King     260000000
##  3         2019            3         7.2 PG          Frozen II         150000000
##  4         2019            4         7.6 PG-13       Spider-Man: Fa…   160000000
##  5         2019            5         6.9 PG-13       Captain Marvel    175000000
##  6         2019            6         7.9 G           Toy Story 4       200000000
##  7         2019            7         8.6 R           Joker              55000000
##  8         2019            8         7   PG          Aladdin           183000000
##  9         2019            9         6.9 PG-13       Star Wars: Epi…   200000000
## 10         2019           10         6.5 PG-13       Fast & Furious…   200000000
## # … with 420 more rows, and 7 more variables: length_in_min <dbl>,
## #   domestic_distributor <chr>, worldwide_gross <dbl>, domestic_gross <dbl>,
## #   genre_1 <chr>, genre_2 <chr>, genre_3 <chr>
interest <- blockbusters %>% mutate(rank = rank(desc(imdb_rating))) %>%
  select(rank, everything()) %>%
  arrange(rank) %>%
  slice(1:5) %>%
  mutate(film_title = fct_recode(film_title, 
                                 LOTR_The_Return_Of_The_King = "The Lord of the Rings: The Return of the King",
                                 LOTR_Fellowship_Of_The_Ring = "The Lord of the Rings: The Fellowship of the Ring"))
interest 
## # A tibble: 5 × 14
##    rank release_year rank_in_year imdb_rating mpaa_rating film_title film_budget
##   <dbl>        <dbl>        <dbl>       <dbl> <chr>       <fct>            <dbl>
## 1   1           2008            1         9   PG-13       The Dark …   185000000
## 2   2.5         2003            1         8.9 PG-13       LOTR_The_…    94000000
## 3   2.5         1993            4         8.9 R           Schindler…    22000000
## 4   5           2010            4         8.8 PG-13       Inception    160000000
## 5   5           2001            2         8.8 PG-13       LOTR_Fell…    93000000
## # … with 7 more variables: length_in_min <dbl>, domestic_distributor <chr>,
## #   worldwide_gross <dbl>, domestic_gross <dbl>, genre_1 <chr>, genre_2 <chr>,
## #   genre_3 <chr>
interest2 <- blockbusters %>% mutate(rank = rank(imdb_rating)) %>%
  select(rank, everything()) %>%
  arrange(rank) %>%
  slice(1:5)
interest2
## # A tibble: 5 × 14
##    rank release_year rank_in_year imdb_rating mpaa_rating film_title film_budget
##   <dbl>        <dbl>        <dbl>       <dbl> <chr>       <chr>            <dbl>
## 1   1           1983            5         3.7 PG          Jaws 3-D      20500000
## 2   2           1983           10         4.6 PG          Staying A…    22000000
## 3   3           2009            7         4.7 PG-13       The Twili…    50000000
## 4   4.5         2011            4         4.9 PG-13       The Twili…   110000000
## 5   4.5         1994            6         4.9 PG          The Flint…    46000000
## # … with 7 more variables: length_in_min <dbl>, domestic_distributor <chr>,
## #   worldwide_gross <dbl>, domestic_gross <dbl>, genre_1 <chr>, genre_2 <chr>,
## #   genre_3 <chr>
library(ggrepel)
ggplot(data = interest, aes(x = release_year, y = domestic_gross)) +
  geom_point(aes(colour = imdb_rating)) +
  geom_label_repel(data = interest, aes(label = film_title)) +
  geom_point(data = interest2, aes(x = release_year, y = domestic_gross, colour = imdb_rating)) +
  geom_label_repel(data = interest2, aes(label = film_title))

History of Rock

## # A tibble: 5,484 × 18
##    index name           artist   release_date length popularity danceability...7
##    <dbl> <chr>          <chr>           <dbl>  <dbl>      <dbl>            <dbl>
##  1     0 Smells Like T… Nirvana          1991   5.03         74            0.502
##  2     1 Stairway to H… Led Zep…         1971   8.05         78            0.338
##  3     2 Bohemian Rhap… Queen            1975   5.91         74            0.392
##  4     3 Imagine - Rem… John Le…         1971   3.13         77            0.547
##  5     4 (I Can't Get … The Rol…         1965   3.71         77            0.723
##  6     5 Hotel Califor… Eagles           1976   6.52         83            0.579
##  7     6 Enter Sandman  Metalli…         1991   5.53         74            0.579
##  8     7 Whole Lotta L… Led Zep…         1969   5.56         77            0.412
##  9     8 Comfortably N… Pink Fl…         1979   6.37         74            0.472
## 10     9 One            U2               1991   4.60         76            0.392
## # … with 5,474 more rows, and 11 more variables: acousticness <dbl>,
## #   danceability...9 <dbl>, energy <dbl>, instrumentalness <dbl>, key <dbl>,
## #   liveness <dbl>, loudness <dbl>, speechiness <dbl>, tempo <dbl>,
## #   time_signature <dbl>, valence <dbl>

Trying to Make Density Ridges Plot

## install.packages("ggridges")
library(ggridges)

nirvana_small <- nirvana %>% slice(1:5) %>%
  mutate(order = fct_reorder(.f = name, .x = valence))
ggplot(data = nirvana_small, aes(x = order, y = valence)) +
  geom_density_ridges() +
  coord_flip() +
  labs(x = "Title",
       y = "Valence")
## Picking joint bandwidth of NaN

Works in Progress - Simple Visualizations

nirvana_line <- nirvana %>% rename(Title = 'name')
plot10 <- ggplot(data = nirvana_line, aes(x = Release_Date, y = Popularity, label = Title)) +
  geom_line() +
  geom_point(colour = "darkolivegreen") +
  labs(x = "Release Date",
       y = "Popularity",
       title = "Comparing Popularity by Release Date") +
  theme_bw() +
  theme(legend.position = "none")

ggplotly(plot10, tooltip = "label")
table <- history_of_rock %>% group_by(artist) %>%
  summarise(mean = mean(popularity)) %>%
  arrange(desc(mean)) %>%
  slice(1:10)

top10 <- history_of_rock %>% arrange(desc(popularity)) %>% slice(1:10)

Unemployment Data Set

library(lubridate)
## 
## Attaching package: 'lubridate'
## The following objects are masked from 'package:base':
## 
##     date, intersect, setdiff, union
unemployment <- read_csv("data/unemployment_data_us.csv")
## Rows: 132 Columns: 13
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr  (2): Month, Date
## dbl (11): Year, Primary_School, High_School, Associates_Degree, Professional...
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
ggplot(data = unemployment, aes(x = Date, y = Professional_Degree)) +
  geom_point()
## Warning: Removed 9 rows containing missing values (geom_point).